00100		SUBROUTINE ACSHFT(RX)
00200		COMMON/SS/X,Y,RH,RN1 /XRN/RN(4000)
00500		COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA
00600		1,DBST,NFLG,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
00900		DIMENSION R(8,100)
01000		EQUIVALENCE (R,RN(3001))
01100		L=K-1
01200		M=L-ABS(RX)
01300		JD=1
01400		RN1=99
01500	CC	RD=20
01600		Y=-.23
01610		Z=Y
01700		IF(RX.LT.0)GO TO 1
01800		L=M
01900		M=K-1
02000		JD=-1
02100	CC	RD=10
02200	1	DO 2 N=M,L,JD
02300	C  DOES IT HAVE AN ACCID?
02400		IF(AMOD(R(5,N),10.).EQ.0)GO TO 2
02500	C  IS THIS THE FIRST ACCID?
02600		IF(RN1.NE.99)GO TO 3
02700		RN1=R(4,N)
02800		GO TO 4
02900	3	RH=R(4,N)
03000		IF(ABS(RH-RN1).LT.5)GO TO 4
03100		RN1=RH
03200		Y=-.23
03300	CC	GO TO 2
03305	4	X=0
03310	CC	IF(R(6,N).EQ.20.AND.Y.GE..23)X=X-.23
03320		IF(R(6,N).EQ.20)X=X-.23
03360		IF(R(6,N).EQ.10)X=.23
03400	      IF((R(6,N+1).EQ.20.OR.R(6,N-1).EQ.20).AND.Y.LE.0)Y=Y-Z
03600		CALL SHFT(0)
03700	C  SO Y DOESN'T GET >1.
03710		Z=X
03720		X=X+Y
03730		IF(X)X=0
03800	5	R(5,N)=R(5,N)+X
03900	2	CONTINUE
04000		END
04100	
04200		SUBROUTINE SHFT(J)
04300		COMMON/SS/X,Y,RH,RN1
04400		Y=Y+.23
04500		IF(X+Y.LT.1)RETURN
04600		RN1=RH
04700		Y=0
04750		IF(J.NE.0)Y=.23
04800		END